1 Executive summary

2 Powtarzalność wyników

Dla zapewnienia powtarzalności wyników przy każdym uruchomieniu raportu dla tych samych danych, ustawiono ziarno dla generatora liczb pseudolosowych.

set.seed(23)

3 Wykorzystane biblioteki

Raport został stworzony przy wykorzystaniu następujących bibliotek.

library(dplyr)
library(ggplot2)
library(tidyr)
library(tibble)
library(plotly)
library(gganimate)
library(caret)
library(randomForest)

4 Kod odpowiedzialny za wczytanie danych z plików

colors <- read.csv("dataset/colors.csv")
parts_cat <- read.csv("dataset/part_categories.csv")
elements <- read.csv("dataset/elements.csv")
parts <- read.csv("dataset/parts.csv")
inv_parts <- read.csv("dataset/inventory_parts.csv")

figs <- read.csv("dataset/minifigs.csv")
inv_figs <- read.csv("dataset/inventory_minifigs.csv")

themes <- read.csv("dataset/themes.csv")
sets <- read.csv("dataset/sets.csv")
inv_sets <- read.csv("dataset/inventory_sets.csv")

inventories <- read.csv("dataset/inventories.csv")

5 Oczyszczenie i przetwarzanie danych

Ta sekcja poświęcona jest przetworzeniu brakujących wartości oraz transformacji wykorzystanych zbiorów danych.

5.1 Zestawy Lego

Pierwsza i bardzo ważna część badanego zbioru danych. Zawierają się tutaj informacje o zestawach Lego, takie jak rok wydania oraz ilość części w zestawie, ale też lata w jakich dany zestaw zadebiutował na rynku.

themes <- setNames(themes, c("theme_id", "theme_name", "parent_id"))
colnames(sets)[colnames(sets) == "name"] <- "set_name"
colnames(sets)[colnames(sets) == "num_parts"] <- "set_num_parts"
colnames(inv_sets)[colnames(inv_sets) == "quantity"] <- "set_qty"

sets_with_themes <- themes %>%
  merge(sets, by = "theme_id") %>%
  select(-c("theme_id","img_url","parent_id"))

5.1.1 Analiza atrybutów

Na wykresach można zaobserwować pewien trend. Wskazuje on na to, że wraz z upływem czasu powstaje coraz więcej zestawów Lego. Dodatkowo są one coraz większe i bardziej rozbudowane, na co wskazuje rosnąca liczba części.

unique_theme_data <- sets_with_themes %>%
    group_by(year) %>%
    filter(year >= 1980) %>%
    filter(year <= 2023) %>%
    summarise(unique_theme = n_distinct(theme_name, na.rm = TRUE))

ggplot(unique_theme_data , aes(x = year, y = unique_theme)) +
    geom_line(aes(y = unique_theme, color = "Unikalne tematyki zestawów"), size = 1) +
    labs(x = "Rok", y = "Liczba tematyk", colour = "Legenda") +
    scale_color_manual(values=c("#fc8d62")) +
    theme_bw()

mean_nparts_data <- sets_with_themes %>%
    group_by(year) %>%
    filter(year >= 1980) %>%
    filter(year <= 2023) %>%
    summarise(sets_mean_nparts = mean(set_num_parts, na.rm = TRUE), sets_count = n())

ggplot(mean_nparts_data , aes(x = year, y = sets_mean_nparts)) +
    ggtitle("Średnia liczba części w zestawach w latach 1980-2023") +
    geom_bar(stat="identity", fill = "#fc8d62") +
    labs(x = "Rok", y = "Liczba części") +
    theme_bw()

5.1.2 Podsumowanie zbioru

knitr::kable(summary(sets_with_themes), caption = "Podstawowe statystyki - zestawy Lego")
Podstawowe statystyki - zestawy Lego
theme_name set_num set_name year set_num_parts
Length:21880 Length:21880 Length:21880 Min. :1949 Min. : 0.0
Class :character Class :character Class :character 1st Qu.:2001 1st Qu.: 3.0
Mode :character Mode :character Mode :character Median :2012 Median : 31.0
Mean :2008 Mean : 161.4
3rd Qu.:2018 3rd Qu.: 139.0
Max. :2024 Max. :11695.0

5.2 Figurki Lego

Kolejna część badanego zbioru danych. Możemy znaleźć tutaj informacje o figurkach m.in. z czego się one składają.

colnames(figs)[colnames(figs) == "name"] <- "fig_name"
colnames(figs)[colnames(figs) == "num_parts"] <- "fig_num_parts"
colnames(inv_figs)[colnames(inv_figs) == "quantity"] <- "fig_qty"
colnames(inventories)[colnames(inventories) == "id"] <- "inventory_id"

inventory_minifigures <- inv_figs %>%
     merge(figs, by = "fig_num") %>%
     merge(inventories, by = "inventory_id") %>%
     merge(sets, by = "set_num") %>%
     select(-c(1:2, 7:9, 11:13))

5.2.1 Analiza atrybutów

Jeśli chodzi o ilość wykorzystywanych w zestawach figurek, to możemy zauważyć, że z czasem wykorzystywane są one coraz częściej.

figures_number <- inventory_minifigures  %>%
    group_by(year) %>%
    filter(year >= 1980) %>%
    filter(year <= 2023) %>%
    summarise(fig_count = n())

ggplot(figures_number , aes(x = year, y = fig_count)) +
     geom_line(aes(y = fig_count, color = "Liczba figurek"), size = 1) +
     labs(x = "Rok", y = "Liczba figurek", colour = "Legenda") +
     scale_color_manual(values=c("#fc8d62")) +
     theme_bw()

5.2.2 Podsumowanie zbioru

knitr::kable(summary(inventory_minifigures), caption = "Podstawowe statystyki - figurki Lego")
Podstawowe statystyki - figurki Lego
fig_num fig_qty fig_name fig_num_parts year
Length:20858 Min. : 1.000 Length:20858 Min. : 0.000 Min. :1975
Class :character 1st Qu.: 1.000 Class :character 1st Qu.: 4.000 1st Qu.:2006
Mode :character Median : 1.000 Mode :character Median : 4.000 Median :2014
Mean : 1.062 Mean : 4.813 Mean :2011
3rd Qu.: 1.000 3rd Qu.: 5.000 3rd Qu.:2019
Max. :100.000 Max. :143.000 Max. :2023

5.3 Części Lego

Ostatania część badanego zestawu danych zawiera informacje na temat części Lego. Znajdują się tutaj szczegóły poszczególnych części: elementy z których się składają, kolory, materiał z którego zostały wykonane oraz kategoria do której przynależą.

colnames(parts)[colnames(parts) == "name"] <- "part_name"
colnames(parts_cat)[colnames(parts_cat) == "name"] <- "part_cat_name"
colnames(parts_cat)[colnames(parts_cat) == "id"] <- "part_cat_id"
colnames(colors)[colnames(colors) == "name"] <- "color_name"
colnames(colors)[colnames(colors) == "id"] <- "color_id"
colnames(inv_parts)[colnames(inv_parts) == "quantity"] <- "part_qty"

element_counts <- elements %>%
  group_by(part_num, color_id) %>%
  summarise(el_per_part = n())

inventory_parts <- inv_parts %>%
  merge(parts, by = "part_num") %>%
  merge(colors, by = "color_id") %>%
  merge(parts_cat, by = "part_cat_id") %>%
  merge(element_counts, by = c("part_num", "color_id")) %>%
  merge(inventories, by = "inventory_id") %>%
  merge(sets, by = "set_num") %>%
  select(-c(1:2, 4, 7:8, 12, 16:17, 19:21))

5.3.1 Analiza atrybutów

W przypadku części Lego również można dostrzeć pewne trendy. Wykorzystywane elementy są coraz bardziej zróżnicowane, poprzez tworzenie części z nowych materiałów oraz w nowych kolorach. Warte wyróżnienia jest, że złożoność części się nie zmieniła (na jedną część średnio przypada 1.5 elementu)

transparent_parts <- inventory_parts %>%
    group_by(is_trans) %>%
    filter(year >= 1980) %>%
    filter(year <= 2023) %>%
    summarise(trans_part_count = n())

ggplot(transparent_parts, aes(x=is_trans, y=trans_part_count, fill=is_trans)) + 
  geom_bar(stat="identity", position="dodge") +
  scale_fill_manual(values = c("t" = "#66c2a5", "f" = "#fc8d62"), labels = c("TAK", "NIE")) +
  scale_x_discrete(labels = c("t" = "TAK", "f" = "NIE")) +
  labs(title = "Zestawienie kolorów (transparentność)", x = "Transparentność", y = "Liczba obserwacji", fill = "Legenda") +
  theme_bw()

unique_data <- inventory_parts %>%
    filter(year >= 1980) %>%
    filter(year <= 2023) %>%
    group_by(year, part_material) %>%
    summarise(count = n(), type = "Material") %>%
    bind_rows(
        inventory_parts %>%
            group_by(year, color_name) %>%
            summarise(count = n(), type = "Color") %>%
            bind_rows(
                inventory_parts %>%
                    group_by(year, part_cat_name) %>%
                    summarise(count = n(), type = "Category")
            )
    )

ggplot(unique_data, aes(x = year, y = count, fill = type)) +
  geom_bar(stat = "identity", position = "dodge") +
  facet_grid(type ~ ., scales = "free_y", labeller = labeller(type = c("Material" = "Materiały", "Color" = "Kolory", "Category" = "Kategorie"))) +
  scale_fill_manual(values = c("Category" = "#66c2a5", "Color" = "#fc8d62", "Material" = "#8da0cb"), labels = c("Kategorie", "Kolory", "Materiały")) +
  labs(x = "Rok", y = "Liczba obserwacji", fill = "Legenda") +
  theme_bw()

elements_count <- inventory_parts %>%
  group_by(year) %>%
  filter(year >= 1980) %>%
  filter(year <= 2023) %>%
  summarise(el_in_part = mean(el_per_part, na.rm = TRUE))

ggplot(elements_count  , aes(x = year, y = el_in_part)) +
  geom_line(aes(color = "Średnia ilość elementów w częściach"), size = 1) +
  labs(x = "Rok", y = "Liczba elementów", colour = "Legenda") +
  scale_color_manual(values=c("#fc8d62")) +
  theme_bw()

5.3.2 Podsumowanie zbioru

knitr::kable(summary(inventory_parts), caption = "Podstawowe statystyki - części Lego")
Podstawowe statystyki - części Lego
part_num part_cat_id part_qty part_name part_material color_name is_trans part_cat_name el_per_part year
Length:1040218 Min. : 1.00 Min. : 1.000 Length:1040218 Length:1040218 Length:1040218 Length:1040218 Length:1040218 Min. :1.000 Min. :1954
Class :character 1st Qu.:11.00 1st Qu.: 1.000 Class :character Class :character Class :character Class :character Class :character 1st Qu.:1.000 1st Qu.:2008
Mode :character Median :15.00 Median : 2.000 Mode :character Mode :character Mode :character Mode :character Mode :character Median :1.000 Median :2016
Mean :21.73 Mean : 3.566 Mean :1.591 Mean :2013
3rd Qu.:28.00 3rd Qu.: 4.000 3rd Qu.:2.000 3rd Qu.:2020
Max. :68.00 Max. :3064.000 Max. :9.000 Max. :2023

5.4 Połączenie danych

dataset <- unique_theme_data %>%
  merge(mean_nparts_data) %>%
  merge(figures_number) %>%
  merge(transparent_parts) %>%
  merge(elements_count)

6 Podsumowanie badanego zbioru

knitr::kable(summary(dataset))
year unique_theme sets_mean_nparts sets_count fig_count is_trans trans_part_count el_in_part
Min. :1980 Min. :14.00 Min. : 66.47 Min. : 74.0 Min. : 48.0 Length:88 Min. : 61982 Min. :1.426
1st Qu.:1991 1st Qu.:24.00 1st Qu.:102.28 1st Qu.: 157.5 1st Qu.: 135.2 Class :character 1st Qu.: 61982 1st Qu.:1.588
Median :2002 Median :56.00 Median :131.77 Median : 420.0 Median : 289.0 Mode :character Median :513352 Median :1.610
Mean :2002 Mean :53.66 Mean :140.95 Mean : 468.8 Mean : 468.2 Mean :513352 Mean :1.598
3rd Qu.:2012 3rd Qu.:79.75 3rd Qu.:171.05 3rd Qu.: 729.5 3rd Qu.: 855.5 3rd Qu.:964721 3rd Qu.:1.638
Max. :2023 Max. :96.00 Max. :307.83 Max. :1149.0 Max. :1301.0 Max. :964721 Max. :1.662

6.1 Trend w rozwoju LEGO

W tej sekcji przedstawiono jak na przestrzeni lat (1980-2023) zmieniały się trendy w Lego. Uwzględniono zmiany w złożoności zestawów (średniej liczby wykorzystywanych w nich części) poprzez wielkość punktu, w porównaniu z ilością wykorzystywanych w zestawach figurek oraz liczby dostępnych zestawów.

Na podstawie wykresu możemy zauważyć, że największy przeskok jeśli chodzi o zaawansowanie zestawów (ich ilośc i złożoność), przypada na okres około 2010 roku.

animation <- dataset %>% 
  select(year, sets_count, fig_count, sets_mean_nparts)

p <- ggplot(animation, aes(x=sets_count, y=fig_count, size = sets_mean_nparts)) +
    geom_point(show.legend = FALSE, alpha = 0.8, color = "#fc8d62") +
    labs(title = 'Rok: {frame_time}', x = "Liczba dostępnych zestawów", y = "Ilość wykorzystywanych figurek") +
    transition_time(year) +
    theme_bw()

animate(p, nframes = 225)

7 Wyznaczenie korelacji

Na poniższym wykresie przedstawiona została wartość współczynnika korelacji Pearsona między parametrami atrybutów w zbiorze.

W tabeli przedstawiono wartości współczynnika korelacji dla poszczególnych par atrybutów.

Wiersz Kolumna Współczynnik korelacji
fig_count sets_count 0.9675649
unique_theme year 0.9640386
sets_count year 0.9477051
sets_count unique_theme 0.9447247
fig_count year 0.9274481
fig_count unique_theme 0.9067765
sets_mean_nparts year 0.7868182
fig_count sets_mean_nparts 0.7656128
sets_count sets_mean_nparts 0.7039379
sets_mean_nparts unique_theme 0.6696571
el_in_part unique_theme 0.3051613
el_in_part year 0.2539668
el_in_part sets_mean_nparts -0.1348402
el_in_part sets_count 0.1026486
el_in_part fig_count 0.0265213
sets_mean_nparts trans_part_count 0.0000000
sets_count trans_part_count 0.0000000
fig_count trans_part_count 0.0000000
trans_part_count year 0.0000000
trans_part_count unique_theme 0.0000000
el_in_part trans_part_count 0.0000000

7.1 Podsumowanie

Wnioski wyciągnięte na podstawień obliczeń współczynnika korelacji:

  • Rok i unikalne tematyki: wraz z upływem czasu na rynku pojawiają się zestawy o nowych tematykach
  • Rok i liczba figurek: wraz z upływem czasu w zestawach znajduje się więcej figurek
  • Rok i średnia liczba części w zestawach: wraz z upływem czasu zestawy stają się coraz bardziej rozbudowane i są większe (więcej części)
  • Liczba elementów w częściach i unikalne tematyki: poszczególne tematyki zestawów różnią się pod względem złożoności części w zestawach
  • Liczba elementów w częściach i średnia liczba części w zestawach: w bardziej rozbudowanych zestawach wykorzystywane klocki są mniej złożone
  • Liczba transparentnych kolorów elementów: brak wykazanej korelacji. Może to sugerować, że to czy element jest przezroczysty, nie jest istotnym aspektem zestawów klocków

8 Klasyfikacja

W tej sekcji opisano wykorzystanie uczenia maszynowego do prognozowania złożoności zestawów Lego, czyli średniej liczby ich części. Do tego celu użyto algorytmu Random Forest, z zastosowaniem metody losowania ze zwracaniem (bootstraping).

8.1 Podział zbioru danych

dataset$is_trans <- as.factor(dataset$is_trans)

inTraining <-
  createDataPartition(
    y = dataset$sets_mean_nparts,
    p = .7,
    list = FALSE)

training <- dataset[inTraining,]
testing <- dataset[-inTraining,]

8.2 Schemat uczenia

Przygotowano schemat uczenia wraz z optymalizacją parametrów modelu. Najlepszy model został stworzony dla parametru liczby zmiennych losowo wybranych jako kandydaci w każdym podziale (mtry) równego 4. Poza tym wybrany model charakteryzuje się najniższym błędem średniokwadratowym (RMSE), który wynosi 20.29928 Dodatkowo miara dopasowania modelu do danych (Rsquared) również jest jedną z wyższych.

rfGrid <- expand.grid(mtry = 2:20)
gridCtrl <- trainControl(method = "boot", number = 100)

8.3 Uczenie modelu

fitTune <- train(sets_mean_nparts ~ .,
               data = training,
               method = "rf",
               trControl = gridCtrl,
               tuneGrid = rfGrid,
               ntree = 40)

fitTune
## Random Forest 
## 
## 64 samples
##  7 predictor
## 
## No pre-processing
## Resampling: Bootstrapped (100 reps) 
## Summary of sample sizes: 64, 64, 64, 64, 64, 64, ... 
## Resampling results across tuning parameters:
## 
##   mtry  RMSE      Rsquared   MAE     
##    2    22.51743  0.8381052  17.18059
##    3    20.72412  0.8599121  15.27948
##    4    20.32661  0.8635669  14.98439
##    5    20.47273  0.8623097  15.05096
##    6    20.59016  0.8595858  15.22843
##    7    20.62173  0.8579696  15.32871
##    8    20.54871  0.8582724  15.27627
##    9    20.88306  0.8538215  15.49705
##   10    20.86593  0.8547343  15.52240
##   11    20.38345  0.8602656  15.09059
##   12    20.52288  0.8589985  15.25982
##   13    20.51089  0.8586256  15.16584
##   14    20.47589  0.8600704  15.24469
##   15    20.50593  0.8596488  15.29586
##   16    20.73137  0.8572988  15.34260
##   17    20.52877  0.8592537  15.26166
##   18    20.61759  0.8583844  15.36097
##   19    20.69999  0.8562868  15.31274
##   20    20.48254  0.8588786  15.21346
## 
## RMSE was used to select the optimal model using the smallest value.
## The final value used for the model was mtry = 4.

8.4 Predykcja

predictions <- predict(fitTune, newdata = testing)

8.5 Ważność atrybutów

important_df <- data.frame(importance(fitTune$finalModel))
important_df$names <- rownames(important_df)


ggplot(important_df, aes(x=names, y=IncNodePurity/100)) + 
  geom_bar(stat="identity", fill = "#fc8d62") +
  labs(title = "Wykres ważności atrybutów w podejmowaniu decyzji", x="Atrybuty", y="Ważność") +
  theme_bw() +
  theme(axis.text.x = element_text(angle = 45, hjust=1))

Na podstawie powyższego wykresu okazuje się, że najważniejszymi atrybutami są:

  • Rok: Wraz z upływem czasu powstające zestawy Lego są coraz bardziej rozbudowane.
  • Liczba figurek: Poziom rozbudowania zestawu wpływa również na liczbę figurek, które się w nim znajdują.

8.6 Zestawienie przewidywań modelu z rzeczywistymi wartościami

compare_df <- testing %>% select(year, sets_mean_nparts)
compare_df$Predict <- predictions

ggplot(compare_df, aes(x = year)) +
  geom_line(aes(y = sets_mean_nparts, color = "Rzeczywista liczba części"), size = 1) +
  geom_line(aes(y = Predict, color = "Przewidywana liczba części"), size = 1) +
  labs(x = "Rok", y = "Średnia liczba części w zestawie") +
  scale_color_manual(name = "Legenda", values = c("Rzeczywista liczba części" = "#fc8d62", "Przewidywana liczba części" = "#8da0cb")) +
  theme_bw()